perm filename FILL.OLD[1,LCS] blob
sn#093922 filedate 1974-03-24 generic text, type T, neo UTF8
00100 IMPLICIT INTEGER(A-Z)
00200 COMMON D(2000),Q(100),R(100),E(100)
00300 DATA Q/5,20,10,2,5,10,7,6,10,91*0/
00400 1,R/8,10,0,8,6,3,5,6,92*0/
00500
00600 15 TOT=9
00700 R(1)=10
00800 R(2)=12
00900 R(3)=0
00950 R(4)=0
01000 R(5)=10
01100 R(6)=8
01200 R(7)=5
01300 R(8)=7
01400 R(9)=8
01410 TYPE 151
01420 151 FORMAT(' TYPE COORDS.'/)
01430 152 FORMAT(60I)
01440 ACCEPT 152,(Q(K),K=1,60)
01450 ACCEPT 152,(R(K),K=1,60)
01500 CC DO 150 K=1,100
01600 CC150 E(K)=0
01610 E(5)=-1
01620 E(9)=-1
01625 ACCEPT 152,(E(K),K=1,60)
01630 CALL LINES(Q(1),R(1),3)
01635 ACCEPT 152,TOT
01640 DO 40 K=2,TOT
01650 J=2
01660 IF(E(K-1))J=3
01670 40 CALL LINES(Q(K),R(K),J)
01700 N=1
01800 4 JJ=0
01900 H=-1000
01950 Z=0
02000 DO 1 K=2,TOT
02100 IF(E(K).NE.0)GO TO 1
02150 A=R(K)
02160 B=R(K-1)
02165 IF(B.GT.A)GO TO 21
02170 C=A*1000+B
02175 GO TO 20
02180 21 C=B*1000+A
02190 20 IF(C.LE.Z)GO TO 1
02195 Z=C
02200 C FINDS HIGHEST LINE
02300 JJ=K
02400 H=R(JJ)
02500 1 CONTINUE
02600
02700 IF(JJ.EQ.0)GO TO 10
02800 J=JJ
02900 JA=J-1
03000 CC JB=J-1
03100 CC IF(JA.GT.TOT)JA=1
03200 CC IF(JB.EQ.0)JB=TOT
03300 CC IF(R(JA).GT.R(JB))GO TO 19
03400 CC JA=J
03500 CC J=JB
03600 C J = END OF HIGHEST LINE
03700 19 RT=Q(J)
03800 LF=Q(JA)
03900 DIS=RT-LF
04000 RJ=R(J)
04100 RJ1=R(JA)
04200 16 E(J)=-1
04300 C LINE USED
04400 CC HT=IABS(RJ-RJ1)
04450 HT=RJ-RJ1
04500 M=1
04600 IF(DIS)M=-1
04700 U=LF
04800 IF(RJ.Lt.RJ1)U=RT
04850 IF(RJ1.LT.RJ)RJ=RJ1
04860 DIS=IABS(DIS)
04900
05000 17 DO 2 K=LF,RT,M
05100 D(N)=K
05200 Y=(HT*(K-U))/DIS+RJ
05300 D(N+1)=Y
05400 H=-1000
05500
05600 18 DO 3 I=2,TOT
05610 IF(E(I))GO TO 3
05655 C SKIP IF SAME LINE.
06100 QA=Q(I)
06200 QB=Q(I-1)
06300 IF((QA.GE.K.AND.QB.GE.K).OR.(QA.LE.K.AND.QB.LE.K))GOTO 3
06400 C LINE WAS NOT UNDER POINT K
06410 RA=R(I)
06420 RB=R(I-1)
06500 HX=IABS(RA-RB)
06600 IF(RA.GT.RB)RA=RB
06700 DX=IABS(QA-QB)
06800 IF(QB.LT.QA)QA=QB
06900 B=(HX*(K-QA))/DX+RA
07210 IF(B.GT.Y)GO TO 3
07300 IF(B.LE.H)GO TO 3
07400 H=B
07500 IX=I
07600 C FOUND HIGHEST NEW POINT
07700 3 CONTINUE
07710 IF(H.EQ.Y)GO TO 2
07800 CC IF(HX)GO TO 30
07900 CC E(IX+1)=1
08000 C WIPES OUT THIS LINE SEG.
08100 CC GO TO 31
08200 30 IF(K.NE.Q(IX).AND.K.NE.Q(IX+1))E(IX)=1
08250 C TOUCHING END OF SEG. DOES NOT COUNT.
08300
08310 IF(H.EQ.-1000)GO TO 2
08400 31 D(N+2)=H
08500 N=N+3
08600 2 CONTINUE
08700
08750 IF(D(N).EQ.-1000)GO TO 4
08800 D(N)=-1000
08900 C MARKS END OF ONE FILL SECTION
09000 N=N+1
09100 GO TO 4
09200
09300 CC10 IF(D(N-1).EQ.-1000)N=N-1
09350 10 N=N-1
09400 D(N-1)=-9999
09500 C MARKS FINAL END
09510 IO=5
09520 33 WRITE(IO,34)(D(K),K=1,N)
09530 34 FORMAT(9I6)
09600 N=1
09700 13 J=3
09800 C FOR INVIS. VECT.
09900 DX=D(N)
10000 12 CALL LINES(DX,D(N+1),J)
10100 J=2
10200 CALL LINES(DX,D(N+2),J)
10300 N=N+3
10400 DX=D(N)
10500 IF(DX.LE.-1000)GO TO 11
10600 CALL LINES(DX,D(N+2),J)
10700 CALL LINES(DX,D(N+1),J)
10800 N=N+3
10900 DX=D(N)
11000 IF(DX.GT.-1000)GO TO 12
11100
11200 11 IF(DX.EQ.-9999)GO TO 14
11300 N=N+1
11400 GO TO 13
11500 14 PAUSE
11600 GO TO 15
11700 END
11800
11900